home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / T U R B O Language / Turbo Pascal V7.0 / TVFM.ZIP / VIEWTEXT.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1992-10-30  |  4.5 KB  |  199 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Vision File Manager Demo               }
  4. {   Copyright (c) 1992 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. unit ViewText;
  9.  
  10. {$F+,O+,X+,S-,D-}
  11.  
  12. interface
  13.  
  14. uses Objects, Views, Dos;
  15.  
  16. type
  17.  
  18.   { TLineCollection }
  19.  
  20.   PLineCollection = ^TLineCollection;
  21.   TLineCollection = object(TCollection)
  22.     procedure FreeItem(P: Pointer); virtual;
  23.   end;
  24.  
  25.   { TFileViewer }
  26.  
  27.   PFileViewer = ^TFileViewer;
  28.   TFileViewer = object(TScroller)
  29.     FileName: PString;
  30.     FileLines: PCollection;
  31.     IsValid: Boolean;
  32.     constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar;
  33.       const AFileName: PathStr);
  34.     constructor Load(var S: TStream);
  35.     destructor Done; virtual;
  36.     procedure Draw; virtual;
  37.     procedure ReadFile(const FName: PathStr);
  38.     procedure SetState(AState: Word; Enable: Boolean); virtual;
  39.     procedure Store(var S: TStream);
  40.     function Valid(Command: Word): Boolean; virtual;
  41.   end;
  42.  
  43.   { TTextWindow }
  44.  
  45.   PTextWindow = ^TTextWindow;
  46.   TTextWindow = object(TWindow)
  47.     constructor Init(R: TRect; const FileName: PathStr);
  48.   end;
  49.  
  50. const
  51.  
  52.   RFileViewer: TStreamRec = (
  53.      ObjType: 10080;
  54.      VmtLink: Ofs(TypeOf(TFileViewer)^);
  55.      Load:    @TFileViewer.Load;
  56.      Store:   @TFileViewer.Store
  57.   );
  58.   RTextWindow: TStreamRec = (
  59.      ObjType: 10081;
  60.      VmtLink: Ofs(TypeOf(TTextWindow)^);
  61.      Load:    @TTextWindow.Load;
  62.      Store:   @TTextWindow.Store
  63.   );
  64.  
  65. procedure RegisterFViewer;
  66.  
  67. implementation
  68.  
  69. uses Drivers, Memory, MsgBox, App;
  70.  
  71. { TLineCollection }
  72. procedure TLineCollection.FreeItem(P: Pointer);
  73. begin
  74.   DisposeStr(P);
  75. end;
  76.  
  77. { TFileViewer }
  78. constructor TFileViewer.Init(var Bounds: TRect; AHScrollBar,
  79.   AVScrollBar: PScrollBar; const AFileName: PathStr);
  80. begin
  81.   TScroller.Init(Bounds, AHScrollbar, AVScrollBar);
  82.   GrowMode := gfGrowHiX + gfGrowHiY;
  83.   FileName := nil;
  84.   ReadFile(AFileName);
  85. end;
  86.  
  87. constructor TFileViewer.Load(var S: TStream);
  88. var
  89.   FName: PathStr;
  90. begin
  91.   TScroller.Load(S);
  92.   FileName := S.ReadStr;
  93.   FName := FileName^;
  94.   ReadFile(FName);
  95. end;
  96.  
  97. destructor TFileViewer.Done;
  98. begin
  99.   Dispose(FileLines, Done);
  100.   DisposeStr(FileName);
  101.   TScroller.Done;
  102. end;
  103.  
  104. procedure TFileViewer.Draw;
  105. var
  106.   B: TDrawBuffer;
  107.   C: Byte;
  108.   I: Integer;
  109.   S: String;
  110.   P: PString;
  111. begin
  112.   C := GetColor(1);
  113.   for I := 0 to Size.Y - 1 do
  114.   begin
  115.     MoveChar(B, ' ', C, Size.X);
  116.     if Delta.Y + I < FileLines^.Count then
  117.     begin
  118.       P := FileLines^.At(Delta.Y + I);
  119.       if P <> nil then S := Copy(P^, Delta.X + 1, Size.X)
  120.       else S := '';
  121.       MoveStr(B, S, C);
  122.     end;
  123.     WriteLine(0, I, Size.X, 1, B);
  124.   end;
  125. end;
  126.  
  127. procedure TFileViewer.ReadFile(const FName: PathStr);
  128. var
  129.   FileToView: Text;
  130.   Line: String;
  131.   MaxWidth: Integer;
  132.   E: TEvent;
  133. begin
  134.   IsValid := True;
  135.   if FileName <> nil then DisposeStr(FileName);
  136.   FileName := NewStr(FName);
  137.   FileLines := New(PLineCollection, Init(5,5));
  138.   {$I-}
  139.   Assign(FileToView, FName);
  140.   Reset(FileToView);
  141.   if IOResult <> 0 then
  142.   begin
  143.     MessageBox('Cannot open file '+FName+'.', nil, mfError + mfOkButton);
  144.     IsValid := False;
  145.   end
  146.   else
  147.   begin
  148.     MaxWidth := 0;
  149.     while not Eof(FileToView) and not LowMemory do
  150.     begin
  151.       Readln(FileToView, Line);
  152.       if Length(Line) > MaxWidth then MaxWidth := Length(Line);
  153.       FileLines^.Insert(NewStr(Line));
  154.     end;
  155.     Close(FileToView);
  156.   end;
  157.   {$I+}
  158.   Limit.X := MaxWidth;
  159.   Limit.Y := FileLines^.Count;
  160. end;
  161.  
  162. procedure TFileViewer.SetState(AState: Word; Enable: Boolean);
  163. begin
  164.   TScroller.SetState(AState, Enable);
  165.   if Enable and (AState and sfExposed <> 0) then
  166.      SetLimit(Limit.X, Limit.Y);
  167. end;
  168.  
  169. procedure TFileViewer.Store(var S: TStream);
  170. begin
  171.   TScroller.Store(S);
  172.   S.WriteStr(FileName);
  173. end;
  174.  
  175. function TFileViewer.Valid(Command: Word): Boolean;
  176. begin
  177.   Valid := IsValid;
  178. end;
  179.  
  180. { TTextWindow }
  181. constructor TTextWindow.Init(R: TRect; const FileName: PathStr);
  182. begin
  183.   inherited Init(R, Filename, wnNoNumber);
  184.   Options := Options or ofTileable;
  185.   GetExtent(R);
  186.   R.Grow(-1, -1);
  187.   Insert(New(PFileViewer, Init(R,
  188.     StandardScrollBar(sbHorizontal + sbHandleKeyboard),
  189.     StandardScrollBar(sbVertical + sbHandleKeyboard), Filename)));
  190. end;
  191.  
  192. procedure RegisterFViewer;
  193. begin
  194.   RegisterType(RFileViewer);
  195.   RegisterType(RTextWindow);
  196. end;
  197.  
  198. end.
  199.